home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / Toolbox Classes / dialog < prev    next >
Text File  |  1993-05-13  |  6KB  |  188 lines
  1. \ Dialog support
  2. \ 12/22/84  cbd Version 1
  3. \  7/23/85  cbd Fixed get:, added ReturnToModal
  4. \  9/06/85  cdn putText & getText made to work with Control items
  5. \  9/20/85  cdn Added draw:, disp: & ParamText
  6. \  7/10/86  cdn Fixed ReturnToModal, added setProc:
  7. \  7/21/86  cdn Added togItem
  8. \ 10/10/86  cdn Added hilite:
  9. \  5/20/90    rfl    the actual hilite is now a frame: method
  10. \ 11/21/90    rfl    added setUserItem and UserItem class
  11. \ 12/24/90    rfl    dialog items now match array items.  First item in
  12. \                dialog array is at position 1.  Position 0 does nothing. Actions: replaced
  13. \ 10/31/91    rfl    modifed userItem to set its rectangle at set time
  14. \ 12/13/91    rfl    SP added alive:
  15. \  9/28/92    rfl    added portBit: to make consistent with portBit: window
  16. \  5/13/93    rfl    protected getnew
  17. Decimal
  18.  
  19. : Closer  close: caller ;
  20.  
  21. Int theItem
  22. Var itemHandle
  23. Int itemType
  24.  
  25. 0 value rtm
  26.  
  27. :CLASS  Dialog  <Super X-Array
  28.  
  29.     Int        Resid
  30.     Var        dialPtr
  31.     Var        procPtr
  32.     Int        boldItem
  33.  
  34.     \ ( -- )
  35.     :M  CLOSE:  get: dialPtr  call DisposDialog clear: dialPtr  ;M
  36.  
  37.     :M  ALIVE: ( -- b) get: dialPtr 0 <> ;M
  38.  
  39.     :M  SET: get: dialPtr call setPort ;M
  40.  
  41.     :M  PORTBIT: ( -- abs) get: dialPtr 2+ ;M
  42.  
  43.     \ ( item# -- hndl )  get handle for item#
  44.     :M  HANDLE:  { item# -- hndl }  get: dialPtr  item# makeInt
  45.         abs: itemType  abs: itemHandle  abs: tempRect
  46.         call GetDItem get: itemHandle  ;M
  47.  
  48.     \ draws the frame around the hilit item
  49.     :M  FRAME:     get: boldItem -dup
  50.         IF    savePort get: dialPtr call SetPort 3 3 pack call PenSize
  51.             handle: self drop -4 -4 inset: tempRect
  52.             abs: tempRect 16 16 pack call FrameRoundRect call penNormal restPort
  53.         THEN ;M
  54.  
  55.     \ ( -- )  create dialog from resID
  56.     :M  GETNEW:  0 int: resid 0 -1  call GetNewDialog dup put: dialPtr
  57.         0= classErr" 170
  58.         frame: self    ;M
  59.  
  60.     :M  SHOW: get: dialPtr call showWindow frame: self ;M
  61.  
  62.     \ ( cfa -- )  set dialog proc
  63.     :M  SETPROC: >body put: procPtr ;M
  64.  
  65.     \ ( -- )  display as modal dialog
  66.     :M  MODAL:
  67.         BEGIN
  68.             get: procPtr dup IF +base THEN abs: theItem call ModalDialog
  69.             get: theItem ( 1-) exec: super
  70.             rtm
  71.         WHILE
  72.             0 -> rtm    \ iterate every time ReturnToModal is executed
  73.         REPEAT
  74.     ;M
  75.  
  76.     \ ( act0 ... actN -- )  set the dialog's action handlers starting at element 1
  77.     :M  ACTIONS: ?ixobj limit 1- 0
  78.         DO limit i- 1- (^elem) !
  79.         LOOP   ;M
  80.  
  81.     \ ( val item# -- )
  82.     :M  PUT:  handle: self  swap makeInt call SetCtlValue   ;M
  83.  
  84.     \ ( item# -- val ) get value for an item#
  85.     :M  GET:   handle: self  >R word0 R>
  86.         call GetCtlValue word0  ;M    \ added word0 cbd 7/17/85
  87.  
  88.     \ ( resID -- )  Associate object with it's resource
  89.     :M  INIT:  put: resID   ;M
  90.  
  91.     :M  PUTRESID: put: resID ;M
  92.  
  93.     \ ( item# -- )  Causes bold outline of the specified item
  94.     :M  HILITE: put: boldItem ;M
  95.  
  96.     \ ( item# -- addr len )  return a text item's text
  97.     :M  GETTEXT: handle: self  buf255 +base   get: ItemType dup 24 and
  98.         IF   drop call GetIText
  99.         ELSE 4 and
  100.              IF   call GetCTitle
  101.              ELSE 2drop 0 buf255 c!        \ user item has no text
  102.             THEN
  103.         THEN
  104.         buf255 count  ;M
  105.  
  106.     \ ( addr len item# -- )  store an item's text
  107.     :M  PUTTEXT: { addr len item# -- } item#  handle: self
  108.         addr len str255   get: ItemType dup 24 and
  109.         IF   drop call SetIText
  110.         ELSE 4 and
  111.              IF   call SetCTitle
  112.              ELSE 2drop                    \ user item has no text
  113.              THEN
  114.         THEN   ;M
  115.  
  116.     \ ( start end item# )  set selection range for text item
  117.     :M  SETSELECT:  { start end item# -- }  get: dialPtr
  118.         item# makeInt start end pack  call SeliText  ;M
  119.  
  120.     \ ( -- )  force drawing of dialog before going to modal:
  121.     :M  DRAW:   get: dialPtr call DrawDialog ;M
  122.  
  123.     \  set user item into dialog; userItem must start with rectangle data
  124.     :M  SETUSERITEM: { userItem -- } item: useritem handle: self drop
  125.         get: tempRect put: userItem
  126.         get: itemType $ 80 and
  127.         IF disable: userItem ELSE enable: userItem THEN
  128.         get: dialPtr getParms: userItem abs: userItem call setDItem ;M
  129.  
  130.     \ ( -- )  Initialize default handlers to close the dialog box
  131.     :M  CLASSINIT:  limit 0 DO 'c closer i to: self LOOP  ;M
  132.  
  133. ;CLASS
  134.  
  135. \ signal modal method to re-enter ModalDialog
  136. : ReturnToModal
  137.     1 -> rtm ;
  138.  
  139. \ Toggle the check box or radio button
  140. : togItem
  141.     get: theItem 1 over get: caller - swap put: caller
  142.     ReturnToModal
  143. ;
  144.  
  145. \ ( addr0 len0 addr1 len1 addr2 len2 addr3 len3 -- )  Substitute Dialog text
  146. : ParamText { \ p1 p2 p3 -- }
  147.      str255 dup -> p3   -base count +
  148.     >str255 dup -> p2   -base count +
  149.     >str255 dup -> p1   -base count +
  150.     >str255     p1 p2 p3 call ParamText
  151. ;
  152.  
  153.  
  154. \    11.21.90    rfl    User Item class for use in dialogs. The proc definition should conform
  155. \                    to IM where the proc draws the item; for example, if the item is a clock,
  156. \                     it wil draw the clock with the current time displayed. When this procedure
  157. \                     is called, the current port will have been set by the Dialog Manager to the
  158. \                     dialog window's grafport. The procedure must have two parameters, a
  159. \                     window pointer and an item number.  If the procedure draws in more than
  160. \                     one dialog window, the ptr tells it which one to draw in. The item number
  161. \                     tells it which item to draw, if it draws more than one. Since itemNo
  162. \                     is an integer, must add word0 to make long.
  163.  
  164. :CLASS userItem <super rect
  165.  
  166.     var myProc
  167.     int    disabled
  168.     int itemNo
  169.  
  170.   :M item:         ( -- n)        get: itemNo ;M
  171.   :M putItem:     ( n --)     put: itemNo ;M
  172.  
  173.   :M disabled?: ( -- int)    int: disabled ;M
  174.  
  175.   :M disable:     ( --)        128 put: disabled ;M
  176.  
  177.   :M enable:     ( --)        clear: disabled ;M
  178.  
  179.   :M setProc:     ( cfaproc --) >body put: myProc ;M
  180.  
  181.   :M getParms:     ( -- int int proc) int: itemNo int: disabled get: myProc +base ;M
  182.  
  183. ;CLASS
  184.  
  185.  
  186. \ example proc to draw Rectangle
  187. \ :PROC drawRect word0 2drop draw: myUserItem ;PROC
  188.